home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch12 / 2dLine.cls < prev    next >
Encoding:
Visual Basic class definition  |  1999-06-17  |  4.5 KB  |  149 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "TwoDLine"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = False
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15. ' Two-dimensional line object.
  16.  
  17. Implements TwoDObject
  18.  
  19. Public X1 As Single
  20. Public Y1 As Single
  21. Public X2 As Single
  22. Public Y2 As Single
  23.  
  24. ' Drawing properties.
  25. Private m_DrawWidth As Integer
  26. Private m_DrawStyle As DrawStyleConstants
  27. Private m_ForeColor As OLE_COLOR
  28. Private m_FillColor As OLE_COLOR
  29. Private m_FillStyle As FillStyleConstants
  30.  
  31. Private Declare Function MoveTo Lib "gdi32" Alias "MoveToEx" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpPoint As Long) As Long
  32. Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
  33.  
  34. ' Draw the object in a metafile.
  35. Private Sub TwoDObject_DrawInMetafile(ByVal mf_dc As Long)
  36.     SetMetafileDrawingParameters Me, mf_dc
  37.     MoveTo mf_dc, X1, Y1, 0
  38.     LineTo mf_dc, X2, Y2
  39.     RestoreMetafileDrawingParameters mf_dc
  40. End Sub
  41. ' Return the object's DrawWidth.
  42. Public Property Get TwoDObject_DrawWidth() As Integer
  43.     TwoDObject_DrawWidth = m_DrawWidth
  44. End Property
  45. ' Set the object's DrawWidth.
  46. Public Property Let TwoDObject_DrawWidth(ByVal new_value As Integer)
  47.     m_DrawWidth = new_value
  48. End Property
  49.  
  50. ' Return the object's DrawStyle.
  51. Public Property Get TwoDObject_DrawStyle() As DrawStyleConstants
  52.     TwoDObject_DrawStyle = m_DrawStyle
  53. End Property
  54. ' Set the object's DrawStyle.
  55. Public Property Let TwoDObject_DrawStyle(ByVal new_value As DrawStyleConstants)
  56.     m_DrawStyle = new_value
  57. End Property
  58.  
  59. ' Return the object's ForeColor.
  60. Public Property Get TwoDObject_ForeColor() As OLE_COLOR
  61.     TwoDObject_ForeColor = m_ForeColor
  62. End Property
  63. ' Set the object's ForeColor.
  64. Public Property Let TwoDObject_ForeColor(ByVal new_value As OLE_COLOR)
  65.     m_ForeColor = new_value
  66. End Property
  67.  
  68. ' Return this object's bounds.
  69. Public Sub TwoDObject_Bound(ByRef xmin As Single, ByRef xmax As Single, ByRef ymin As Single, ByRef ymax As Single)
  70.     If X1 < X2 Then
  71.         xmin = X1
  72.         xmax = X2
  73.     Else
  74.         xmin = X2
  75.         xmax = X1
  76.     End If
  77.     If Y1 < Y2 Then
  78.         ymin = Y1
  79.         ymax = Y2
  80.     Else
  81.         ymin = Y2
  82.         ymax = Y1
  83.     End If
  84. End Sub
  85. ' Return the object's FillColor.
  86. Public Property Get TwoDObject_FillColor() As OLE_COLOR
  87.     TwoDObject_FillColor = m_FillColor
  88. End Property
  89. ' Set the object's FillColor.
  90. Public Property Let TwoDObject_FillColor(ByVal new_value As OLE_COLOR)
  91.     m_FillColor = new_value
  92. End Property
  93.  
  94. ' Return the object's FillStyle.
  95. Public Property Get TwoDObject_FillStyle() As FillStyleConstants
  96.     TwoDObject_FillStyle = m_FillStyle
  97. End Property
  98. ' Set the object's FillStyle.
  99. Public Property Let TwoDObject_FillStyle(ByVal new_value As FillStyleConstants)
  100.     m_FillStyle = new_value
  101. End Property
  102.  
  103. ' Draw the object on the canvas.
  104. Public Sub TwoDObject_Draw(ByVal canvas As Object)
  105.     SetCanvasDrawingParameters Me, canvas
  106.     canvas.Line (X1, Y1)-(X2, Y2), m_ForeColor
  107. End Sub
  108. ' Initialize the object using a serialization string.
  109. ' The serialization does not include the
  110. ' ObjectType(...) part.
  111. Private Property Let TwoDObject_Serialization(ByVal RHS As String)
  112. Dim token_name As String
  113. Dim token_value As String
  114.  
  115.     InitializeDrawingProperties Me
  116.  
  117.     ' Read tokens until there are no more.
  118.     Do While Len(RHS) > 0
  119.         ' Read a token.
  120.         GetNamedToken RHS, token_name, token_value
  121.         Select Case token_name
  122.             Case "X1"
  123.                 X1 = CSng(token_value)
  124.             Case "Y1"
  125.                 Y1 = CSng(token_value)
  126.             Case "X2"
  127.                 X2 = CSng(token_value)
  128.             Case "Y2"
  129.                 Y2 = CSng(token_value)
  130.             Case Else
  131.                 ReadDrawingPropertySerialization Me, token_name, token_value
  132.         End Select
  133.     Loop
  134. End Property
  135.  
  136. ' Return a serialization string for the object.
  137. Public Property Get TwoDObject_Serialization() As String
  138. Dim txt As String
  139.  
  140.     txt = DrawingPropertySerialization(Me)
  141.     txt = txt & " X1(" & Format$(X1) & ")"
  142.     txt = txt & " Y1(" & Format$(Y1) & ")"
  143.     txt = txt & " X2(" & Format$(X2) & ")"
  144.     txt = txt & " Y2(" & Format$(Y2) & ")"
  145.     TwoDObject_Serialization = "TwoDLine(" & txt & ")"
  146. End Property
  147.  
  148.  
  149.